home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
STUTTGART
/
EDITORS
/
LEDIT
/
!lEdit
/
l
/
lispmode
< prev
next >
Wrap
Text File
|
1995-01-21
|
20KB
|
570 lines
;;; *** lEdit - Lisp Editor ***
;;; (c) 1995 Urs Bisang
;;; Version 0.1
;;;
;;; dieses file enthaelt die routinen und handler speziell fuer
;;; den lisp modus von ledit!
;;;
;;; *** globale variablen ***
;; der name eines neuen text buffers
(define *lisp-untitled-name* "<untitled>")
;; default werte des options menu
(define *lisp-options-pause* 1.0)
;; der name des lisp modes
(define *lisp-mode-name* 'Lisp)
;; default name zum speichern von lisp files
(define *lisp-default-name* "LispFile")
;; ** globale state variablen fuer das options menu **
;; automatisches paren matching nach eingabe einer
;; schliessenden klammer
(define *lisp-option-match* #t)
;; automatisches einruecken nach dem eingabe von return
(define *lisp-option-ident* #t)
;; flag fuer animation beim einruecken
(define *lisp-option-animate* #t)
;; flag fuer spezielles einruecken (shift-TAB!)
(define *lisp-special-ident* #f)
;;; *** lisp editor window menus ***
;; ** misc submenu **
(define lisp-misc-submenu
(menu-new "Misc" ">Info,New view,Print,Undo F8,Redo F9"))
;; handle die submenu eintraege
(define (lisp-handle-misc-submenu item text)
(let ((i (menu-subitem item)))
(cond
((menu-item i 1) (show-proginfo))
((menu-item i 2) (text-new-view text))
((menu-item i 3) (text-print text))
((menu-item i 4) (txt-undo text))
((menu-item i 5) (txt-redo text)))))
;; ** save submenu **
;; handle die submenu eintraege
(define (lisp-handle-save-submenu item text)
(cond
((= (length item) 2) (text-saveas text))
((= (length item) 1) (text-save text))
(else (ierr "bad save selection"))))
;; ** select submenu **
(define lisp-select-submenu
(menu-new "Select" ">Save,Print,Copy ^C,Move ^V,Delete ^X,Clear ^Z"))
;; update submenu bevor es angezeigt wird
(define (lisp-update-select-submenu)
;; falls keine text-selection vorliegt mache die
;; entsprechenden menu Eintraege nicht selektierbar
(if (txtscrap-selectowner)
(menu-change lisp-select-submenu
setflags: 0 0 entry: 1
setflags: 0 0 entry: 2
setflags: 0 0 entry: 3
setflags: 0 0 entry: 4
setflags: 0 0 entry: 5
setflags: 0 0 entry: 6)
(menu-change lisp-select-submenu
setflags: 0 1 entry: 1
setflags: 0 1 entry: 2
setflags: 0 1 entry: 3
setflags: 0 1 entry: 4
setflags: 0 1 entry: 5
setflags: 0 1 entry: 6)))
;; handle die submenu eintraege
(define (lisp-handle-select-submenu item text)
(let ((i (menu-subitem item)))
(cond
((menu-item i 1) (text-save-selection text))
((menu-item i 2) (text-print-selection text))
((menu-item i 3) (text-copy-selection text))
((menu-item i 4) (text-move-selection text))
((menu-item i 5) (text-delete-selection))
((menu-item i 6) (text-clear-selection)))))
;; ** edit submenu **
(define lisp-edit-submenu
(menu-new "Edit" (string-concat
">Find F4,>Goto F5,>Replace F6,"
"Ident TAB,RecIdent ^R,Match () ^M,"
"Next ( ^A,Previous ( ^S,Next ) ^D,"
"Previous ) ^F")))
;; handle die submenu eintraege
(define (lisp-handle-edit-submenu item text)
(let ((i (menu-subitem item)))
(cond
((menu-item i 1) (text-find-dbox text))
((menu-item i 2) (text-goto-dbox text))
((menu-item i 3) (text-replace-dbox text))
((menu-item i 4) (lisp-identline text))
((menu-item i 5) (lisp-rec-identline text))
((menu-item i 6) (lisp-ctrl-m text))
((menu-item i 7) (lisp-next-opening-paren text))
((menu-item i 8) (lisp-previous-opening-paren text))
((menu-item i 9) (lisp-next-closing-paren text))
((menu-item i 10) (lisp-previous-closing-paren text)))))
;; ** options submenu **
(define lisp-options-submenu
(menu-new "Options" "Ident,Match (),Animate"))
;; update submenu bevor es angezeigt wird
(define (lisp-update-options-submenu)
(menu-change lisp-options-submenu
setflags: (if *lisp-option-ident* 1 0) 0 entry: 1)
(menu-change lisp-options-submenu
setflags: (if *lisp-option-match* 1 0) 0 entry: 2)
(menu-change lisp-options-submenu
setflags: (if *lisp-option-animate* 1 0) 0 entry: 3))
;; handle die submenu eintraege
(define (lisp-handle-options-submenu item text)
(let ((i (menu-subitem item)))
(cond
((menu-item i 1) (set! *lisp-option-ident*
(not *lisp-option-ident*)))
((menu-item i 2) (set! *lisp-option-match*
(not *lisp-option-match*)))
((menu-item i 3) (set! *lisp-option-animate*
(not *lisp-option-animate*))))))
;; ** das haupt menu fuer den lisp mode **
(define lisp-ledit-menu
(menu-new "lEdit" "Misc,>Save F3,Select,Edit,Options"))
(menu-change lisp-ledit-menu
submenu: lisp-misc-submenu entry: 1
submenu: lisp-select-submenu entry: 3
submenu: lisp-edit-submenu entry: 4
submenu: lisp-options-submenu entry: 5)
;; der handler und maker fuer das editor window menu
(define (lisp-ledit-menu-maker&handler item text)
(cond
((equal? item :make-menu) (lisp-ledit-menu-maker text))
((menu-item item 1) (lisp-handle-misc-submenu item text))
((menu-item item 2) (lisp-handle-save-submenu item text))
((menu-item item 3) (lisp-handle-select-submenu item text))
((menu-item item 4) (lisp-handle-edit-submenu item text))
((menu-item item 5) (lisp-handle-options-submenu item text))
(else (ierr "unknown menu item"))))
;; der maker fuer das editor window menu
(define (lisp-ledit-menu-maker text)
(lisp-update-select-submenu)
(lisp-update-options-submenu)
lisp-ledit-menu)
;; lade ein lisp file und zeige es in einem neuen window an.
;; pruefe ob das file schon mal geladen wurde
(define (lisp-load-file filename)
(if (not (text-file-loaded? filename)) ; schon geladen ?
(let ((text (gensym)))
(set-eval! text (txt-new ""))
(setp! text 'modename *lisp-mode-name*)
(setp! text 'defaultname *lisp-default-name*)
(setp! text 'filename filename)
(setp! text 'update-handler text-update-title)
(text-update-title text)
(txt-eventhandler text lisp-event-handler)
(event-attachmenumaker (txt-syshandle text)
lisp-ledit-menu-maker&handler
text)
(txt-show text)
(if (not (txt-load text filename 0 #t))
(werr 0 "can't load file '" filename "'"))
(text-cursor-home text) ; zeige den anfang des files
(txt-setcharoptions text 4 0) ; file nicht upgedated !
(set! *text-bufferlist* (cons text *text-bufferlist*)))))
;; oeffne ein neues editor window und trage den buffer
;; in die text buffer liste ein
(define (lisp-new-editor-window)
(let ((text (gensym)))
(set-eval! text (txt-new ""))
(setp! text 'modename *lisp-mode-name*)
(setp! text 'defaultname *lisp-default-name*)
(setp! text 'update-handler text-update-title)
(text-update-title text)
(txt-eventhandler text lisp-event-handler)
(event-attachmenumaker (txt-syshandle text)
lisp-ledit-menu-maker&handler
text)
(txt-show text)
(set! *text-bufferlist* (cons text *text-bufferlist*))))
;; ** der default handler fuer mouse events **
(define (lisp-handle-mouse text x)
(cond
((txt-icon-dragged? x) (text-insert-dragged-file text))
((txt-select-clicked? x) (lisp-select-clicked text x))
((txt-adjust-clicked? x) (if (txt-selectset text)
(lisp-adjust-pressed text x)))
((txt-closeicon? x) (text-close-window text))
((txt-scrollarrow-up? x) (txt-movevertical text -1 1))
((txt-scrollarrow-down? x) (txt-movevertical text 1 1))
((txt-scrollbar-up? x) (text-cursor-pageup text))
((txt-scrollbar-down? x) (text-cursor-pagedown text))
((txt-select-pressed? x) (lisp-select-pressed text x))
((txt-adjust-pressed? x) (lisp-adjust-pressed text x))
(else (wimp-processkey x))))
;; ** routinen zur behandlung der mouse events **
;; select clicked innerhalb des editor windows
(define (lisp-select-clicked text x)
;; setze cursor an die click position
(txt-setdot text (txt-mouse-position x))
;; mach window aktiv (setze input focus!)
(txt-setcharoptions text 2 2))
;; selcet pressed innerhalb des editor windows.
;; mache eine text selektion
(define (lisp-select-pressed text x)
(let ((start (txt-dot text))
(end (txt-mouse-position x)))
(if (< start end)
(txtscrap-setselect text start end)
(txtscrap-setselect text end start))))
;; adjust pressed innerhalb des editor windows
;; veraendere eine text selektion
(define (lisp-adjust-pressed text x)
(let ((old-start (txt-selectstart text))
(old-end (txt-selectend text))
(new-val (txt-mouse-position x)))
(cond
((> new-val old-end) (txtscrap-setselect text old-start new-val))
((< new-val old-start) (txtscrap-setselect text new-val old-end))
((< (- old-end new-val) (- new-val old-start))
(txtscrap-setselect text old-start new-val))
(else (txtscrap-setselect text new-val old-end)))))
;;; *** der default input event handler ***
(define (lisp-event-handler text)
(let ((x (txt-get text)))
(cond
;; behandle mouse events getrennt
((txt-mouse-event? x) (lisp-handle-mouse text x))
;; behandle home und page up und page down
((txt-key-home? x) (text-cursor-home text))
;; behandle arrow keys
((txt-key-up? x) (txt-movevertical text -1 0))
((txt-key-down? x) (txt-movevertical text 1 0))
((txt-key-left? x) (txt-movedot text -1))
((txt-key-right? x) (txt-movedot text 1))
((txt-key-ctrl-up? x) (text-cursor-home text))
((txt-key-ctrl-down? x) (text-cursor-end text))
((txt-key-ctrl-left? x) (txt-setdot text (txt-begin-of-line text))
(txt-movedot text (txt-identlevel text)))
((txt-key-ctrl-right? x) (txt-setdot text (txt-end-of-line text)))
;; behandle page up und page down
((txt-key-pagedown? x) (text-cursor-pagedown text))
((txt-key-pageup? x) (text-cursor-pageup text))
;; behandle delete, backspace und (copy)
((txt-key-delete? x) (lisp-delete* text))
((txt-key-backspace? x) (lisp-delete* text))
((txt-key-copy? x) (lisp-delete text))
;; behandle tabulator
((txt-key-tab? x) (lisp-identline text))
((txt-key-shift-tab? x) (let ((*lisp-special-ident* #t))
(lisp-identline text)))
;; behandle die function-keys
((txt-key-functionkey? x) (lisp-handle-functionkeys text x))
;; behandle die ctrl-key tastenkombinationen
((akbd-pollctl) (lisp-handle-ctrlkeys text x))
;; behandle return taste speziell, wegen identing
((txt-key-return? x) (lisp-handle-return text))
;; behandle die schliessende klammer speziell
((= x #\)) (lisp-insert-paren text))
;; behandle normale buchstaben, d.h. fuege sie beim cursor
;; ein und bewege cursor nach rechts
((txt-key-char? x) (txt-insertchar* text x))
(else (wimp-processkey x)))))
;; ** routinen zur behandlung der keyboard events **
;; ist es ein spezial kontext, wo die klammern einzeln
;; interpretiert werden und nicht als klammern paare?
;; zum beispiel in kommentaren, strings, etc.
(define (lisp-special-context? text)
(let ((i (txt-dot text)))
(or (txt-lisp-comment? text i)
(txt-lisp-charconst? text i)
(txt-lisp-string? text i))))
;; insert closing paren and highlight matching paren!
(define (lisp-insert-paren text)
(if (lisp-special-context? text)
(txt-insertchar* text #\))
(begin
(txt-insertchar text #\))
(lisp-highlight-paren text (txt-dot text))
(txt-movedot text 1))))
;; highlight matching paren
(define (lisp-highlight-paren text i)
(let ((j (txt-lisp-matchparen text i)))
(cond ((and j *lisp-option-match*)
(txt-setdot text j)
(delay *lisp-options-pause*)
(txt-setdot text i)))))
;; highlight matching paren
(define (lisp-ctrl-m text)
(let ((i (txt-dot text))
(j (cond ((and (> i 0) (= (txt-charat text (- i 1)) #\)))
(txt-lisp-matchparen text (- i 1)))
((= (txt-charat text i) #\()
(if (txt-lisp-matchparen text i)
(+ (txt-lisp-matchparen text i) 1)))
(else #f))))
(cond (j (txt-setdot text j)
(delay *lisp-options-pause*)
(txt-setdot text i)))))
;; gehe zur naechsten oeffnenden klammer
(define (lisp-next-opening-paren text)
(txt-movedot text 1)
(let ((i (txt-lisp-nextparen text :forward #\()))
(if i
(txt-setdot text i)
(txt-movedot text -1))))
;; gehe zur vorhergehenden (matching) oeffnenden klammer
(define (lisp-previous-opening-paren text)
(txt-movedot text -1)
(let ((i (txt-lisp-nextparen text :backward #\)))
(j (if i (txt-lisp-matchparen text i) #f)))
(if j
(txt-setdot text j)
(txt-movedot text 1))))
;; gehe zur naechsten (matching) schliessenden klammer
(define (lisp-next-closing-paren text)
(let ((i (txt-lisp-nextparen text :forward #\())
(j (if i (txt-lisp-matchparen text i) #f)))
(if j (txt-setdot text (+ j 1)))))
;; gehe zur vorhergehenden schliessenden klammer
(define (lisp-previous-closing-paren text)
(txt-movedot text -2)
(let ((i (txt-lisp-nextparen text :backward #\))))
(if i
(txt-setdot text (+ i 1))
(txt-movedot text 2))))
;; wie ctrl-m aber der cursor wird zusaetzlich um 1 bewegt
(define (lisp-ctrl-n text)
(lisp-ctrl-m text)
(delay 1.8)
(txt-movedot text 1))
;; loesche text in einem text buffer unter beruecksichtigung
;; der regeln fuer lisp klammern nach dem cursor
(define (lisp-delete text)
(let ((ch (txt-charatdot text)))
(if (= ch #\))
;; behandle schliessende klammer gesondert
(lisp-delete-paren text)
;; loesche das zeichen beim cursor
(txt-delete text 1))))
;; loesche ein zeichen in einem text buffer unter beruecksichtigung
;; der regeln fuer klammern vor dem cursor
(define (lisp-delete* text)
(if (< 0 (txt-dot text))
;; behandle schliessende klammer gesondert
(if (= (txt-charat text (- (txt-dot text) 1)) #\))
(lisp-delete-paren* text)
;; loesche das zeichen vor dem cursor
(txt-delete* text 1))))
;; loesche eine klammer oder ein klammernpaar nach dem cursor
(define (lisp-delete-paren text)
(if (not (lisp-special-context? text))
(lisp-highlight-paren text (txt-dot text)))
(txt-delete text 1))
;; loesche eine klammer oder ein klammernpaar vor dem cursor
(define (lisp-delete-paren* text)
(txt-movedot text -1)
(if (not (lisp-special-context? text))
(lisp-highlight-paren text (txt-dot text)))
(txt-movedot text 1)
(txt-delete* text 1))
;; behandle die ctrl-key tastenkombinationen
(define (lisp-handle-ctrlkeys text x)
(cond
((= x #x1a) (text-clear-selection)) ; Ctrl-Z
((= x #x18) (text-delete-selection)) ; Ctrl-X
((= x #x03) (text-copy-selection text)) ; Ctrl-C
((= x #x16) (text-move-selection text)) ; Ctrl-V
((= x #x0d) (lisp-ctrl-m text)) ; Ctrl-M
((= x #x0e) (lisp-ctrl-n text)) ; Ctrl-N
((= x #x12) (lisp-rec-identline text)) ; Ctrl-R
((= x #x01) (lisp-next-opening-paren text)) ; Ctrl-A
((= x #x13) (lisp-previous-opening-paren text)) ; Ctrl-S
((= x #x04) (lisp-next-closing-paren text)) ; Ctrl-D
((= x #x06) (lisp-previous-closing-paren text)) ; Ctrl-F
(else (wimp-processkey x))))
;; behandle die function keys
(define (lisp-handle-functionkeys text x)
(let ((key (txt-key-functionkey? x)))
(cond
((= key 3) (text-saveas text))
((= key 4) (text-find-dbox text))
((= key 5) (text-goto-dbox text))
((= key 6) (text-replace-dbox text))
((= key 8) (txt-undo text))
((= key 9) (txt-redo text))
(else (wimp-processkey x)))))
;;; ** routinen fuers lisp identing **
;; gib newline aus und ident die zeile entsprechend den
;; vorhergehenden zeilen
(define (lisp-handle-return text)
(if *lisp-option-ident*
(let ((i (txt-lisp-calcident text)))
(if i
(lisp-newline text i)
(begin
(werr 0 "paren mismatch - can't ident correctly")
(lisp-newline text 0))))
(lisp-newline text 0)))
;; gib newline aus und ruecke neue zeile eine
(define (lisp-newline text n)
(txt-newline text)
(if (not *lisp-option-animate*)
(text-dont-update text))
(txt-insertspaces text n)
(if (not *lisp-option-animate*)
(text-update text)))
;; ruecke zeile entsprechend den regeln ein
(define (lisp-identline text)
(let ((old-pos (txt-dot text))
(old-ilevel (txt-identlevel text))
(new-ilevel 0))
(if (not *lisp-option-animate*)
(text-dont-update text))
(txt-setdot text (txt-begin-of-line text))
(cond ((> (txt-dot text) 0)
(txt-movedot text -1)
(set! new-ilevel (txt-lisp-calcident text))
(txt-movedot text 1)
(cond (new-ilevel
(txt-delete text old-ilevel)
(txt-insertspaces text new-ilevel)
(txt-setdot text (+ old-pos (- new-ilevel old-ilevel))))
(else (werr 0 "paren mismatch - can't ident correctly")
(txt-setdot text old-pos))))
(else (txt-setdot text old-pos)))
(if (not *lisp-option-animate*)
(text-update text))))
;; ruecke zeilen rekursiv entsprechend den regeln ein,
;; bis eine nichtleere zeile mit zero identing gefunden wird
(define (lisp-rec-identline text)
(if (not *lisp-option-animate*)
(text-dont-update text))
(let ((*lisp-option-animate* #t)) ; shadow old value
(lisp-identline text)
(let ((reset-pos (txt-dot text))
(old-pos reset-pos))
(txt-setdot text (txt-begin-of-line text))
(txt-movevertical text 1 0)
(while (and (\= old-pos (txt-dot text))
(or (txt-emptyline? text)
(\= (txt-identlevel text) 0)))
(lisp-identline text)
(set! old-pos (txt-dot text))
(txt-movevertical text 1 0))
(txt-setdot text reset-pos)))
(if (not *lisp-option-animate*)
(text-update text)))
;; die hook funktion fuers lisp identing
(define (txt-lisp-ident-hook token)
(cond (*lisp-special-ident* (- 1 (length token)))
;; token fuer wtk
((equal? token "lambda") -5)
((equal? token "define") -5)
((equal? token "let") -2)
((equal? token "define-syntax") -12)
;; zusaetzliche token fuer scheme
((equal? token "let*") -3)
((equal? token "letrec") -5)
;; einige token fuer common lisp
((equal? token "defun") -4)
((equal? token "defvar") -5)
((equal? token "defconst") -7)
((equal? token "defmacro") -7)
((equal? token "defclass") -7)
((equal? token "defmethod") -8)
(else #f)))